home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / v9n07.arc / PCACCESS.BAS < prev    next >
BASIC Source File  |  1990-03-16  |  30KB  |  806 lines
  1.  
  2. '----- PCACCESS.BAS - QuickBASIC communications and file download utility
  3. '
  4. 'Written for PC Magazine by Jay Munro
  5. '
  6. ' Compile and Link syntax:   BC /o/x PCAccess;
  7. '                            LINK /ex PCAccess;
  8.  
  9. DEFINT A-Z                              'Use integers unless over-ridden
  10.  
  11. '----- QuickBASIC Subprograms
  12. DECLARE SUB AbortFile (FileName$)       'Clears buffer, closes file
  13. DECLARE SUB Call800 ()                  'Calls 800 Phones number
  14. DECLARE SUB CurSettings ()              'Prints Current Setup
  15. DECLARE SUB PrintLogo ()                'Prints PCMag logo and help
  16. DECLARE SUB HalfSec ()                  'Delaying tactics
  17.                                         'Checks blocks for errors
  18. DECLARE SUB CheckBlock (Message$, Status, Ptr, CRCTable%())
  19. DECLARE SUB flushbuf ()                 'Flushes COM buffer
  20. DECLARE SUB Immediate (CRCTable%(), PromptData$()) 'Direct file transfer sub
  21. DECLARE SUB Logon (X)                   'Auto-logon routine
  22. DECLARE SUB MakeCRCTable (CRCTable%())  'Builds CRC value table
  23. DECLARE SUB XModemSub (CRCTable%())     'XModem handler
  24.  
  25. '----- QuickBASIC Functions
  26. DECLARE FUNCTION CRCCalc$ (A)           'CRC value function
  27. DECLARE FUNCTION FiltInp$ (InString$)   'Filters out special characters
  28. DECLARE FUNCTION GetString% (SearchSt$, ExitCode) 'Finds ID/Password/Etc.
  29. DECLARE FUNCTION GetKey$ ()             'get single key
  30.  
  31. ON ERROR GOTO ErrorCheck                'Directs errors to trap area
  32.  
  33. '----- Set up shared variables
  34. DIM SHARED ACK$, CAN$, EOT$, NAK$, SOH$, BlockOk, CurBlk&, ComSpec$
  35. DIM SHARED Phone$, DialCmd$, ErrCount, ID$, Password$, Quit$
  36. DIM SHARED DirectFlag%, FileName$, NoGo%, SeeInput%, MiscFlag%
  37.  
  38. '----- Set program constants
  39. ACK$ = CHR$(6)                          'Acknowledge Character
  40. CAN$ = CHR$(24)                         'Cancel transmission
  41. EOT$ = CHR$(4)                          'End of Transmission
  42. NAK$ = CHR$(21)                         'Negative Acknowledge
  43. SOH$ = CHR$(1)                          'Start of Header
  44. Quit$ = CHR$(0) + CHR$(46)              'Abort File Character ALT-C
  45. Do800 = 0
  46. DefaultPhone$ = "1 800 346 3247"
  47. SeeInput% = 0                           'Flag to tell getstring to echo
  48.                                         '   modem input
  49.  
  50. DEF SEG = 0
  51. IF PEEK(&H463) <> &HB4 THEN
  52.    COLOR 14, 1                          'Set colors of display
  53. ELSE
  54.    COLOR 7, 0
  55. END IF
  56. DEF SEG
  57.  
  58. REDIM PromptData$(7, 2)                 'Array for direct download Commands
  59. REDIM SHARED LogonData$(3, 2)           'Array for logon commands
  60.  
  61. REDIM CRCTable%(255)                    'Dim an array for CRC value table
  62.  
  63. CALL MakeCRCTable(CRCTable%())          'Fill the table
  64.  
  65. ComSpec$ = "COM1:1200,E,7,1,BIN,CS0"    'default settings
  66. '  note: use "1200,N,8,1,BIN,CS0" after joining PC MagNet
  67.  
  68. DialCmd$ = "ATDT"                       'Hayes command for Tone dialing
  69.  
  70. '----- Clear screen and display help and logo
  71. CLS
  72. CALL PrintLogo
  73. GOSUB ScriptData                        'Load array of direct download commands
  74.  
  75. '============ Open & retrieve configuration
  76.  
  77. FileSpec$ = "PCAccess.CNF"              'File spec for configuration
  78. ConfigOpen% = -1                        'Flag for error handling
  79. OPEN FileSpec$ FOR INPUT AS #4          'retrieve configuration
  80.       LINE INPUT #4, ComSpec$
  81.       LINE INPUT #4, DialCmd$
  82.       LINE INPUT #4, Phone$
  83.       LINE INPUT #4, ID$
  84.       LINE INPUT #4, Password$
  85.       LINE INPUT #4, Setup$
  86.       LINE INPUT #4, ShellFile$
  87. CLOSE #4
  88. GOTO OpenSerialPort                     'Jump over config stuff
  89.  
  90. GetConfig:                              'Label for error return on above open
  91.   GOSUB FirstTime                       'No .CNF file, then prompt for info
  92.  
  93. '----- Open the COM port
  94. OpenSerialPort:
  95.  
  96. ConfigOpen% = 0                         'Reset error handling on file not found
  97.  
  98. VIEW PRINT 1 TO 25                      'Allow full screen printing
  99.   CLS                                   'Clear old junk
  100.   CALL PrintLogo                        'Print logo and help
  101.   LOCATE 1, 60, 1                       'Print current comspec
  102.   PRINT LEFT$(ComSpec$, 15)
  103. VIEW PRINT 5 TO 25                      'Use area between lines 4 and 25
  104.  
  105. OPEN ComSpec$ FOR RANDOM AS #1          'Open communications buffer
  106.                                         'Put additional set-up here if needed
  107. IF LEN(Setup$) THEN                     'Allow user to specify setup string
  108.    PRINT #1, Setup$
  109. ELSE
  110.    PRINT #1, "ATZ"                         'Reset modem
  111. END IF
  112.  
  113. PRINT "Setting up Modem"
  114.  
  115. Ok = GetString%("OK", ExitCode%)        'Hold until modem returns an OK
  116.  
  117. IF Ok THEN
  118.    PRINT "Modem Ready"                  'If OK then print modem ready
  119. ELSE
  120.    PRINT "Modem not responding"         'otherwise alert user
  121.    PRINT "press ALT-X to quit"
  122.    Do800 = 0
  123. END IF
  124.  
  125. IF Do800 THEN                           'If needed, go for the number
  126.    CALL Call800
  127.    Do800 = 0
  128.    GOTO InputLoop
  129. END IF
  130.  
  131. IF INSTR(COMMAND$, "I") THEN            'Direct download from command line
  132.    DirectFlag% = 1 ' "I" on command line
  133.    CALL Immediate(CRCTable%(), PromptData$())
  134.    IF NoGo% THEN PRINT #1, "BYE"        'Optional one shot download
  135. END IF
  136.  
  137. '----- Main input handler
  138. InputLoop:                              'Input/Output loop
  139.    DO
  140.       I$ = INKEY$                       'Get keystroke from keyboard
  141.       IF LEN(I$) THEN                   'See if anything was entered
  142.          I = ASC(RIGHT$(I$, 1))         'Normal keys return LEN=1, extended
  143.          IF LEN(I$) = 2 THEN I = -I     '  keys return LEN=2
  144.                                         'Set extended scan code to -number
  145.          SELECT CASE I                  'Check for special keys
  146.             CASE -23                    'Immediate mode downloads directly
  147.                DirectFlag% = -1
  148.                CALL Immediate(CRCTable%(), PromptData$())
  149.             CASE -45                    'Alt-X
  150.                EXIT DO
  151.             CASE -32                    'Alt-D - Dial a number
  152.                CALL Logon(0)               '   and do autologon
  153.                PRINT
  154.             CASE -38                    'Alt-L - Just do autologon
  155.                CALL Logon(-1)
  156.                PRINT
  157.             CASE -19                    'Alt-R - Receive a file via XModem
  158.                CALL XModemSub(CRCTable%())
  159.             CASE -31                    'ALT-S  Set up configuration
  160.                ReConfig% = -1
  161.                EXIT DO
  162.             CASE -49                    'ALT-N  get CIS Numbers
  163.                X% = INSTR(ComSpec$, "N,8")
  164.                IF X% THEN
  165.                   MID$(ComSpec$, X%, 3) = "E,7"  'retread comspec for CIS
  166.                   CLOSE #1
  167.                   OPEN ComSpec$ FOR RANDOM AS #1
  168.                END IF
  169.                CALL Call800
  170.                PRINT
  171.             CASE -35                    'ALT-H  hang up
  172.                PRINT #1, "+++";
  173.                FOR X = 1 TO 3
  174.                   CALL HalfSec
  175.                NEXT X
  176.                PRINT #1, "ATH"
  177.             CASE -59                    'F1 - additional Help
  178.                PRINT "F2 - Current Settings   F3 - Shell to DOS   F4 - Open/Close Logfile"
  179.  
  180.             CASE -60                    'F2 - show current settings of
  181.                CALL CurSettings         'phone-id-etc..
  182.  
  183.             CASE -61                    'F3 - shell to dos
  184.                VIEW PRINT 1 TO 25          'Allow full screen printing
  185.  
  186.                CLS                         'Clear old junk
  187.                IF LEN(ShellFile$) THEN
  188.                   SHELL ShellFile$         'The 'ol shell game
  189.                ELSE
  190.                   SHELL
  191.                END IF
  192.  
  193.                CLS                         'cleanup on return
  194.                CALL PrintLogo              'Print logo and help
  195.                LOCATE 1, 60, 1             'Print current comspec
  196.                PRINT LEFT$(ComSpec$, 15)
  197.                VIEW PRINT 5 TO 25          'Use area between lines 4 and 25
  198.             
  199.              CASE -62                   'F4 - open/close log file
  200.                PRINT #1, CHR$(19);
  201.                IF LogIt% THEN
  202.                   IF BufPtr% THEN
  203.                      X$ = LEFT$(Buffer$, BufPtr%)
  204.                      PUT #6, , X$
  205.                   END IF
  206.                   CLOSE #6
  207.                   PRINT "Log file closed "
  208.                   LogIt% = 0
  209.                ELSE
  210.                   LINE INPUT "Enter Log File Name "; LogFile$
  211.                   IF LEN(LogFile$) THEN
  212.                      OPEN LogFile$ FOR BINARY AS #6
  213.                      PRINT "Log File "; LogFile$; " Opened "
  214.                      LogIt% = -1
  215.                      BufSize% = 512
  216.                      Buffer$ = SPACE$(BufSize%)
  217.                      BufPtr% = 1
  218.                   END IF
  219.                END IF
  220.                PRINT #1, CHR$(17);
  221.  
  222.              CASE ELSE                     'Send anything else to the modem
  223.                PRINT #1, I$;               'Semi-colon prevents sending CR/LF
  224.                
  225.          END SELECT
  226.       END IF
  227.  
  228.       IF NOT EOF(1) THEN                'Check the modem for characters
  229.          Minput$ = INPUT$(LOC(1), #1)   'LOC(1) = # of characters in buffer
  230.          PRINT FiltInp$(Minput$);       'Print filtered input
  231.           IF LogIt% THEN                'Log to file
  232.              MID$(Buffer$, BufPtr%) = Minput$ 'Use a pointer to track input
  233.              BufPtr% = BufPtr% + LEN(Minput$) ' Mid$ is faster than
  234.                 IF BufPtr% > BufSize% THEN    ' concatinating strings
  235.                    PRINT #1, CHR$(19);        ' Send an XOFF while we save
  236.                    X$ = LEFT$(Buffer$, BufPtr%) 'PUT needs a real string
  237.                    PUT #6, , X$                 'PUT Latest
  238.                    BufPtr% = 1                  'Reset Pointer
  239.                    PRINT #1, CHR$(17);   'Send XON to resume
  240.                 END IF
  241.            END IF
  242.       END IF
  243.    LOOP                                 'Keep looping until we want to end
  244. CLOSE
  245.  
  246. IF ReConfig% THEN                       'Setup flag
  247.    GOSUB FirstTime                      'Go get Setup info
  248.    ReConfig% = 0
  249.    GOTO OpenSerialPort
  250. END IF
  251.  
  252. END
  253. ErrorCheck:
  254. SELECT CASE ERR                         'Not all these error codes are needed
  255.                                         ' Ones with * are recommended
  256.    CASE 24                              '* Modem probably wasn't connected
  257.       PRINT "Device Timeout!"           '  to phone line
  258.    CASE 52                              'Probably asked for COM port that
  259.       PRINT "Bad File Name!"            '  didn't exist (ie. COM3:)
  260.    CASE 53                              'Use this if you modify for uploading
  261.       IF ConfigOpen% THEN RESUME GetConfig
  262.  
  263.       PRINT "File not found! "          '  downloading doesn't need it
  264.    CASE 57                              '* Trap I/O error
  265.       Err57% = Err57% + 1               'and give it slack before reporting it
  266.       IF Err57% > 5 THEN                'to avoid errors when exiting
  267.          PRINT "Device I/O Error!"      'More than 5, report it
  268.          Err57% = 0
  269.       END IF
  270.    CASE 61                              '* Bad error when downloading
  271.       PRINT "Disk full!"                'Try to start with enough room
  272.    CASE 68
  273.       PRINT "Device Unavailable! "      '* COM port doesn't exist, or under
  274.    CASE 69                              'this is a fatal error
  275.       PRINT "Buffer Overflow - Fatal "
  276.       CLOSE
  277.       END
  278.    CASE 71                              '* Tried to access disk with open
  279.       PRINT "Drive not ready!"          '  drive door
  280.    CASE 75
  281.       PRINT "Path/File access error"
  282.    CASE 76                              '*
  283.       PRINT "Path not found"
  284.    CASE ELSE                            '* Do it yourself error lookup
  285.       PRINT "Error "; ERR; " Occurred"
  286. END SELECT
  287. IF INKEY$ <> "" THEN END                'Unconditional bail out on any error
  288. RESUME
  289.  
  290.  
  291. FirstTime:                              'Setup information prompts
  292.  
  293.         PRINT "Configuration:"
  294.         PRINT
  295.         PRINT "Which Com Port is your modem on ? (1/2) ";
  296.         IF GetKey$ = "2" THEN Port$ = "COM2:" ELSE Port$ = "COM1:"
  297.  
  298.         IF MiscFlag% THEN RETURN         'ESC pressed, bag out
  299.  
  300.         PRINT "<T>one or <P>ulse dialing ";
  301.         IF GetKey$ = "P" THEN DialCmd$ = "ATDP" ELSE DialCmd$ = "ATDT"
  302.  
  303.         IF MiscFlag% THEN RETURN         'ESC pressed, bag out
  304.  
  305. PRINT "Select Baud Rate: "
  306. PRINT "1 - 300 "
  307. PRINT "2 - 1200"
  308. PRINT "3 - 2400"
  309. SELECT CASE GetKey$
  310.     CASE "1"
  311.       Baud$ = "300"
  312.     CASE "3"
  313.       Baud$ = "2400"
  314.     CASE ELSE
  315.       Baud$ = "1200"
  316. END SELECT
  317.  
  318. IF MiscFlag% THEN RETURN                 'ESC pressed, bag out
  319.  
  320. PRINT "Select Com specs - 7 bits when signing up, 8 bits for regular use"
  321. PRINT "1 - 7 bits, E parity, 1 stop"
  322. PRINT "2 - 8 bits, N parity, 1 stop"
  323. IF GetKey$ = "2" THEN Bits$ = ",N,8,1" ELSE Bits$ = ",E,7,1"
  324.  
  325. IF MiscFlag% THEN RETURN                 'ESC pressed, bag out
  326.  
  327. PRINT "If you need to find your local PC MagNet phone number"
  328. PRINT "press enter for the following prompts"
  329.  
  330. LINE INPUT "Enter your local phone number "; Phone$
  331. IF Phone$ = "" THEN Phone$ = DefaultPhone$
  332. LINE INPUT "Enter your ID "; ID$
  333. IF ID$ = "" THEN ID$ = "177000,5000"
  334. LINE INPUT "Enter your Password "; Password$
  335. IF Password$ = "" THEN Password$ = "PC*MAGNET"
  336. LINE INPUT "Enter Modem Initialization string "; Setup$
  337. LINE INPUT "Enter Shell program to run "; ShellFile$
  338.  
  339. IF Phone$ = DefaultPhone$ THEN
  340.     PRINT "Do you wish to call Compuserve's phone number service now? Y/N"
  341.     IF GetKey$ = "Y" THEN
  342.        Bits$ = ",E,7,1"                   'Force 7 bits for CIS
  343.        ComSpec$ = Port$ + Baud$ + Bits$ + ",BIN,CS0"
  344.        Do800 = -1
  345.        GOTO SaveConfig
  346.     END IF
  347. END IF
  348.  
  349. ComSpec$ = Port$ + Baud$ + Bits$ + ",BIN,CS0"
  350.  
  351. CALL CurSettings                          'Print settings
  352. PRINT "Is this correct ?   Y/N or ESC to cancel changes";
  353.  
  354. IF GetKey$ = "N" THEN GOTO FirstTime
  355.  
  356. IF MiscFlag% THEN RETURN                   'ESC pressed, bag out
  357.  
  358. SaveConfig:
  359. PRINT "Saving configuration "
  360.  
  361. OPEN "PCAccess.CNF" FOR OUTPUT AS #4
  362.    PRINT #4, ComSpec$
  363.    PRINT #4, DialCmd$
  364.    PRINT #4, Phone$
  365.    PRINT #4, ID$
  366.    PRINT #4, Password$
  367.    PRINT #4, Setup$
  368.    PRINT #4, ShellFile$
  369. CLOSE #4
  370.  
  371. RETURN
  372.  
  373. '==================
  374. ScriptData:
  375. RESTORE DirData                         '
  376.  
  377. FOR X% = 1 TO 7                         'Read download data into array
  378.    READ PromptData$(X%, 1)              'Read 'wait for' prompt
  379.    READ PromptData$(X%, 2)              'Read 'answer' value
  380. NEXT X%
  381. RESTORE LogData
  382.  
  383. FOR X% = 1 TO 3                        'Read download data into array
  384.    READ LogonData$(X%, 1)              'Read 'wait for' prompt
  385.    READ LogonData$(X%, 2)              'Read 'answer' value
  386. NEXT X%
  387.  
  388. RETURN
  389.  
  390. DirData:                                'direct download commands
  391.  
  392. DATA  !,GO UTILITIES,!,4,"):",,"):",Y,<CR>,,transfer!,1,complete,,
  393.  
  394. LogData:
  395.  
  396. DATA ":",CIS,":",,":",,
  397. ' LogonData$ # 2,2 & 3,2  will be filled in later
  398.  
  399. SUB AbortFile (FileName$) STATIC
  400.     CALL flushbuf                       'Wait for clear line
  401.     PRINT #1, CAN$; CAN$; CAN$;         'Send Cancel signal
  402.     PRINT "*** File Aborted ***"        'Alert user
  403.     CLOSE #2                            'Close file
  404. END SUB
  405.  
  406. SUB Call800
  407.  
  408. PRINT "This will call PC MagNets Phones service"
  409. PRINT "Follow instructions and make a note of your local phone number"
  410. PRINT "After you have logged off, press Alt-S to update your configuration"
  411. PRINT
  412. PRINT "Calling 1-800-346-3247"
  413. T! = TIMER
  414.  
  415. CALL HalfSec
  416.  
  417. Temp$ = DialCmd$ + "1 800 346 3247"
  418.  
  419. PRINT #1, DialCmd$ + "1 800 346 3247"
  420.  
  421. FOR X = 1 TO 10
  422.   Ok = GetString%("CONNECT", ExitCode)
  423.   IF Ok THEN
  424.      CALL HalfSec
  425.      PRINT "Connected to CIS phone service"
  426.      PRINT #1, CHR$(13)
  427.      EXIT FOR
  428.   END IF
  429.  
  430.   IF ExitCode THEN
  431.      PRINT "No Answer"
  432.      EXIT SUB
  433.   END IF
  434. NEXT X
  435.  
  436. FOR X = 1 TO 5
  437.   Ok = GetString%("Name:", ExitCode)
  438.   IF Ok THEN
  439.      PRINT #1, "Phones"
  440.      PRINT "You're on, just follow instructions"
  441.      EXIT SUB
  442.   END IF
  443. NEXT X
  444.  
  445. PRINT "PC MagNet Phones service not answering"
  446.  
  447. END SUB
  448.  
  449. SUB CheckBlock (Message$, Status%, Ptr%, CRCTable%()) STATIC
  450.    'Status =  1-OK get more (saved)
  451.    '          2-Retry block
  452.    '          3-Sender Abort
  453.    '          4-End of file (close)
  454.  
  455.    BlockOk% = 0
  456.    SELECT CASE LEFT$(Message$, 1)       'Check for:
  457.       CASE EOT$                         'End of Transmission (good)
  458.          Status% = 4
  459.          EXIT SUB
  460.       CASE CAN$                         'Canceled by sender (not so good)
  461.          Status% = 3
  462.          EXIT SUB
  463.       CASE IS <> SOH$                   'Start Of Header bad (out of sync)
  464.          IF Ptr% < 10 AND CurBlk& = 1 THEN 'probably start of file
  465.             PRINT #1, "C";              'So signal again
  466.             Status% = 2                 'Set Status for retry
  467.             ErrCount% = ErrCount% + 1   'bump error count
  468.             EXIT SUB
  469.          END IF
  470.          Status% = 1                    'Bad block
  471.          PRINT "SOH error"              'Report type of error
  472.          CALL flushbuf                  'Clear modem buffer
  473.       CASE ELSE                         'Check current block # vs sent block #
  474.          BlockOk% = ((CurBlk& AND 255) = ASC(MID$(Message$, 2, 1)))
  475.          BlockOk% = ((ASC(MID$(Message$, 2, 1)) XOR 255) = (ASC(MID$(Message$, 3, 1))))
  476.          IF BlockOk% THEN
  477.             CRC$ = CHR$(0) + CHR$(0)    'Message CRC created in this routine
  478.  
  479.             FOR MG% = 4 TO 131          'Each character is considered and
  480.                                         '  CRC on total message is created
  481.                 CRCH1 = ASC(LEFT$(CRC$, 1))
  482.                 CRCL2 = CVI(CHR$(0) + RIGHT$(CRC$, 1))
  483.                 CRC1$ = MKI$(CRCTable%(CRCH1 XOR ASC(MID$(Message$, MG%, 1))) XOR CRCL2)
  484.                 CRC$ = RIGHT$(CRC1$, 1) + LEFT$(CRC1$, 1)
  485.             NEXT MG%
  486.  
  487.             Status% = 1                 'Preset status to get next block
  488.                                         'Compare calculated CRC with sent CRC
  489.             IF CRC$ = MID$(Message$, 132, 2) THEN
  490.                BlockOk% = -1            'It is good!
  491.             ELSE
  492.                PRINT "CRC error"        'It is not good
  493.                BlockOk% = 0
  494.                Status% = 0
  495.             END IF
  496.          ELSE
  497.             Status% = 1
  498.             PRINT "Block ID error"
  499.          END IF
  500.     END SELECT
  501.  
  502.    IF NOT BlockOk% THEN                 'If block is bad then
  503.       ErrCount% = ErrCount% + 1         '  bump error count, and report the
  504.                                         '  block number that is at fault
  505.       PRINT "*** Error - Block #"; CurBlk&
  506.       PRINT "*** Error count "; ErrCount%
  507.       PLAY "L16O3EC"
  508.    END IF
  509.  
  510. END SUB
  511.  
  512. FUNCTION CRCCalc$ (A%)                          'Don't make this SUB STATIC!
  513.    HiCrc% = HiCrc% XOR A%
  514.    LoCrc% = 0
  515.    FOR CT% = 0 TO 7                             'Do the calculation
  516.        Carry = 0                                'Clear carry bit
  517.        IF HiCrc > 127 THEN Carry = -1           'Is High bit on in CRC?
  518.        HiCrc = (HiCrc * 2) AND 255              'Shift High byte left 1 bit
  519.        IF LoCrc > 127 THEN HiCrc = HiCrc + 1    'Carry bit from LoCRC to Hi
  520.        LoCrc = (LoCrc * 2) AND 255              'Shift Low byte left 1 bit
  521.        IF Carry THEN                            'If not carry then skip this
  522.           HiCrc = HiCrc XOR 16                  '&H10 in hex
  523.           LoCrc = LoCrc XOR 33                  '&H21
  524.        END IF
  525.    NEXT CT%                                     'Go get another shift
  526.    CRCCalc$ = CHR$(LoCrc) + CHR$(HiCrc)         'Assign function = CRC
  527.  
  528. END FUNCTION
  529.  
  530. SUB CurSettings
  531.  
  532. PRINT STRING$(40, "=")
  533. PRINT "   Phone : "; Phone$
  534. PRINT "      ID : "; ID$
  535. PRINT "Password : "; Password$
  536. PRINT "ComSpecs : "; ComSpec$           'Port$ + Baud$ + Bits$
  537. IF LEN(Setup$) THEN PRINT "Modem setup :"; Setup$
  538. IF LEN(ShellFile$) THEN PRINT "Shell Program :"; ShellFile$
  539. PRINT STRING$(40, "=")
  540.  
  541. END SUB
  542.  
  543. FUNCTION FiltInp$ (InString$) STATIC
  544.    DO                                           'Converts backspace
  545.       BackSpace = INSTR(InString$, CHR$(8))     'Characters to left arrows
  546.       IF BackSpace THEN
  547.          MID$(InString$, BackSpace) = CHR$(29)
  548.       END IF
  549.    LOOP WHILE BackSpace
  550.  
  551.    '----- Strip out any line feed characters
  552.    DO
  553.       LineFeed = INSTR(InString$, CHR$(10))
  554.       IF LineFeed THEN
  555.          InString$ = LEFT$(InString$, LineFeed - 1) + MID$(InString$, LineFeed + 1)
  556.       END IF
  557.    LOOP WHILE LineFeed
  558.  
  559.    FiltInp$ = InString$
  560. END FUNCTION
  561.  
  562. SUB flushbuf
  563.     IF LOF(1) THEN
  564.       DO UNTIL EOF(1)                             'Flush buffer
  565.        Junk$ = INPUT$(1, 1)                    'Input into dummy string
  566.       LOOP
  567.     END IF
  568. END SUB
  569.  
  570. FUNCTION GetKey$
  571. A$ = ""
  572. WHILE A$ = ""                     'Loop until we get a key
  573.    A$ = UCASE$(INKEY$)
  574. WEND
  575. IF A$ = CHR$(27) THEN
  576.    MiscFlag% = -1
  577. ELSE
  578.    MiscFlag% = 0
  579.    PRINT A$
  580. END IF
  581. GetKey$ = A$
  582.  
  583. END FUNCTION
  584.  
  585. FUNCTION GetString% (SearchSt$, ExitCode%) STATIC
  586.     GetString% = 0                              'Preset function value
  587.     Timeout! = TIMER + 5                        'Set a retry timeout
  588.     Minput$ = ""                                'Clear input string
  589.  
  590.     DO                                          'Press any key to bail out
  591.        IF INKEY$ <> "" THEN
  592.           ExitCode% = -1
  593.           EXIT FUNCTION
  594.        END IF
  595.        IF TIMER > Timeout! THEN
  596.                                                 'Did we time out looking
  597.            IF INSTR(Minput$, "MORE !") THEN     ' for prompt only to be
  598.               PRINT #1, CHR$(13);               ' thwarted by a MORE !
  599.               Timeout! = TIMER + 5              'Yes, reset timer and do it
  600.            ELSE
  601.               EXIT FUNCTION   'Bail out on timeout
  602.            END IF
  603.        END IF
  604.        IF TIMER > Timeout! THEN EXIT FUNCTION   'Bail out on timeout
  605.        IF LOC(1) THEN
  606.            I$ = INPUT$(LOC(1), 1)               'Get modem input
  607.            IF SeeInput% THEN PRINT I$;
  608.            Minput$ = Minput$ + I$
  609.        END IF
  610.     LOOP UNTIL INSTR(Minput$, SearchSt$)        'Keep getting until a match
  611.     PRINT
  612.     GetString% = -1                             'Success!!!
  613. END FUNCTION
  614.  
  615. SUB HalfSec
  616. T! = TIMER
  617. WHILE TIMER < T! + .5
  618. WEND
  619. END SUB
  620.  
  621. SUB Immediate (CRCTable%(), PromptData$())
  622.   
  623.    PRINT "Immediate Mode - Enter file to download: ";
  624.    INPUT FileName$                      'Prompt user for file to download
  625.    PRINT "Exit PC MagNet when done ? "
  626.    IF GetKey$ = "N" THEN NoGo% = 0 ELSE NoGo% = -1
  627.    IF FileName$ = "" THEN GOTO OutHere  'Allow exit
  628.    PRINT "Press ENTER to quit"
  629.    PromptData$(3, 2) = FileName$        'Assign array element to filename$
  630.    IF DirectFlag% = 1 THEN              'If started with an I on command line
  631.       CALL Logon(0)                     ' then log on to PC MagNet
  632.    ELSE                                 'Otherwise
  633.       PRINT #1, "GO PCM-1"              ' go to Main screen to start
  634.    END IF
  635.    
  636. FOR X% = 1 TO 7                         'Loop through commands
  637.    DO                                   'Do this until we receive a prompt
  638.      IF ExitCode THEN GOTO OutHere      '  or an exit code
  639.        Ok = GetString%(PromptData$(X%, 1), ExitCode)
  640.        IF Ok THEN
  641.           PRINT PromptData$(X%, 2)      'Echo to screen to show were active
  642.           PRINT #1, PromptData$(X%, 2)  'Send command out modem
  643.        END IF
  644.    LOOP UNTIL Ok                        'Keep looping until valid
  645. NEXT X%
  646.   
  647.    Ok = GetString%(PromptData$(7, 1), ExitCode%)
  648.    CALL XModemSub(CRCTable%())          'Go download the file
  649.    PRINT #1, " "                        'Print a Carriage return
  650.  
  651. OutHere:
  652.    DirectFlag% = 0                      'Reset flag for later use
  653.  
  654. END SUB
  655.  
  656. SUB Logon (LogOnOnly%)
  657.  
  658.    ExitCode% = 0
  659.    LogonData$(2, 2) = ID$
  660.    LogonData$(3, 2) = Password$
  661.    IF NOT LogOnOnly% THEN
  662.  
  663.       IF Phone$ = "" THEN                'Prompt if a number is not specified
  664.          INPUT "Enter Number to Dial ", Phone$
  665.          IF Phone$ = "" THEN EXIT SUB
  666.       END IF
  667.  
  668.       PRINT "*** Dialing "; Phone$       'Dialing message
  669.       PRINT #1, DialCmd$; Phone$         'Send dial command + number to modem
  670.       DO
  671.          IF GetString%("CONNECT", ExitCode) THEN EXIT DO  'exit on connect
  672.          I% = I% + 1                    'Increment number of trys
  673.          IF ExitCode THEN               'If a key was hit, exit
  674.             PRINT "Aborted Logon"       '  with abort message
  675.             EXIT SUB
  676.          END IF
  677.       LOOP WHILE I% < 10                'Loop until there are too many trys
  678.  
  679.       IF I% = 10 THEN                   'Tried too many times, exit
  680.          PRINT "No answer"
  681.          EXIT SUB
  682.       END IF
  683.  
  684.       PRINT "Connected"                 'Connection detected
  685.       PRINT "*** Logging On ***"        'Message
  686.    END IF
  687.   
  688.    Ok% = GetString%("CONNECT", ExitCode%)  'just a dummy to insure time on
  689.  
  690.       PRINT #1, ""                      'Print a <CR> to port
  691.       IF ID$ = "" OR Password$ = "" THEN EXIT SUB
  692.  
  693.  SeeInput% = -1                         'watch what's happening
  694.  
  695.  FOR X% = 1 TO 3                        'Loop through commands
  696.      DO                                 'Do this until we receive a prompt
  697.        IF ExitCode THEN
  698.            PRINT "Logon aborted"
  699.            GOTO OutOut       '  or an exit code
  700.        END IF
  701.           Ok = GetString%(LogonData$(X%, 1), ExitCode)
  702.           IF Ok THEN
  703.           IF X > 2 THEN SeeInput% = 0
  704.           PRINT #1, LogonData$(X%, 2)  'Send command out modem
  705.           END IF
  706.      LOOP UNTIL Ok                        'Keep looping until valid
  707.   NEXT X%
  708.  
  709. OutOut:
  710.  
  711. END SUB
  712.  
  713. SUB MakeCRCTable (CRCTable%()) STATIC
  714.    FOR X% = 0 TO 255                    'Assign CRC for each possible number
  715.       CRCTable%(X%) = CVI(CRCCalc$(X%)) ' from 0-255 (8 bits)
  716.    NEXT X%
  717. END SUB
  718.  
  719. SUB PrintLogo STATIC
  720. LOCATE 1, 1, 1                          'Print logo, help and comspec
  721. PRINT TAB(10); "PC Magazine  -  PCAccess";
  722. PRINT "Alt-R:Receive File   Alt-X:Exit   Alt-D:Dial   Alt-L:Log On   Alt-C:Cancel Xfer";
  723. PRINT "Alt-S:Setup          Alt-H:Hangup              Alt-N:Numbers (CIS Phone service)"
  724. PRINT STRING$(80, 205)
  725. END SUB
  726.  
  727. SUB XModemSub (CRCTable%()) STATIC
  728.     CurBlk& = 1                         'Set current block to 1
  729.     BlockOk% = 0                        'Clear good block flag
  730.     Timeout! = 10                       'Set time out (20 sec. for relaxed)
  731.     ErrCount% = 0                       'Clear the error counter
  732.     TBlock% = 133                       'Total block size CRC
  733.     Abort% = 0
  734.     PRINT FileName$
  735.  
  736.     IF DirectFlag% = 0 THEN
  737.        INPUT ">>>> Enter file name to Receive > ", FileName$
  738.        IF FileName$ = "" THEN EXIT SUB     'User just pressed Enter
  739.     END IF
  740.  
  741.     OPEN FileName$ FOR OUTPUT AS #2     'Open the output file
  742.     PRINT "*** Sending start character ***"
  743.     PRINT #1, "C";                      '"C" requests CRC protocol
  744.  
  745.     DO
  746.        IF ErrCount% > 14 THEN
  747.           CALL AbortFile(FileName$)
  748.           EXIT SUB                      'Too many errors, exit
  749.        END IF
  750.      
  751.        Buffer$ = SPACE$(TBlock%)        'Pad buffer to TBlock% characters
  752.  
  753.        FOR Ptr = 1 TO LEN(Buffer$)      'Assume we fill the whole buffer
  754.           T! = TIMER                    'Start a timer for timeout
  755.           DO UNTIL LOC(1)               'Wait for a character to come in port
  756.              IF INKEY$ = Quit$ THEN Abort% = -1  'User requested abort
  757.                                         'Short timeout for EOT
  758.              IF LEFT$(Buffer$, 1) = EOT$ AND TIMER > T! + 3 THEN EXIT FOR
  759.                                         'short timeout to start
  760.              IF CurBlk& = 1 AND TIMER > T! + 3 THEN EXIT FOR
  761.                                         'If timed out, jump out of loop
  762.              IF TIMER > T! + Timeout! THEN EXIT FOR
  763.           LOOP
  764.                                         'Put any characters into Buffer$
  765.           MID$(Buffer$, Ptr, 1) = INPUT$(1, 1)
  766.        NEXT
  767.       
  768.        IF INKEY$ = Quit$ OR Abort% THEN  'User requesting abort
  769.             CALL AbortFile(FileName$)
  770.             EXIT SUB
  771.        END IF
  772.  
  773.        CALL CheckBlock(Buffer$, Status%, Ptr%, CRCTable%())
  774.  
  775.        SELECT CASE Status%
  776.           CASE 1
  777.              IF BlockOk% THEN
  778.                 PRINT #2, MID$(Buffer$, 4, 128);      'the data block
  779.                 ErrCount% = 0                         'Reset error count
  780.                 PRINT #1, ACK$;                       'Signal 'OK' to sender
  781.                 PRINT "Block "; CurBlk&, CurBlk& * 128; " Bytes" 'update user
  782.                 CurBlk& = CurBlk& + 1                 'Bump block count
  783.              ELSE
  784.                 CALL flushbuf
  785.                 PRINT #1, NAK$
  786.              END IF
  787.           CASE 3                                      'File aborted
  788.              CALL AbortFile(FileName$)
  789.              EXIT DO
  790.           CASE 4                                      'File received okay
  791.              PRINT #1, ACK$;                          'Acknowledge end of file
  792.              CLOSE #2                                 'Close output file
  793.              CLS
  794.              PRINT " *** End of transfer ";           'say that we're done
  795.                                                       'How much we received
  796.              PRINT ((CurBlk& - 1) * 128); " Bytes received"
  797.              PRINT " File: "; FileName$; " saved"     'What was saved
  798.              PRINT "Press Enter"
  799.              PLAY "L16O2ECG"                          'Use BEEP with OS/2
  800.              EXIT DO                                  '
  801.           CASE ELSE                                   'Either retry or resend
  802.        END SELECT
  803.     LOOP
  804. END SUB
  805.  
  806.